home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 25 / lzhc.zip / LZHC.PAS < prev   
Pascal/Delphi Source File  |  1989-04-17  |  4KB  |  164 lines
  1. PROGRAM LHZConvert;
  2.  
  3. { (c)1989 CollisionWare Premium SoftWare, written by Kito Mann }
  4. { Uses CWARE unit which will soon be avaailable <maybe under different name> }
  5. { Modify this program as you wish, but PLEASE, keep it within the bounderies }
  6. { of being able to Exec() PKZIP, etc with only 256k. It was written to be as }
  7. { small as possible. And please, if you modify this for the public use, send }
  8. { me a copy. }
  9.  
  10. { Collision Theory PM-BBS 10PM-7AM (703)425-4674 }
  11.  
  12. {$M 9000,0,0}
  13.  
  14. Uses Dos,
  15.      Cware;
  16.  
  17. Var
  18.   PKUNPAK,
  19.   PKUNZIP,
  20.   PAK,
  21.   LHARC,
  22.   WORKDIR: String[80];
  23.   d,s,s2,s3:string[80];
  24.   Dir: DirStr;
  25.   FileExt: ExtStr;
  26.   FileName: NameStr;
  27.   FilePath: PathStr;
  28.   f,f2:file of byte;
  29.   fz,fz2:longint;
  30.   pakb,arcb,zipb:boolean;
  31.   x,i,z,k:integer;
  32.   ErrorCode : byte;
  33.   SRec: SearchRec;
  34.   Delfile: boolean;
  35.   t: text;
  36.  
  37. Procedure Parse;
  38. begin
  39.    s:=ParamStr(1);
  40.    d:=ParamStr(2);
  41.    for i:=1 to length(s) do
  42.    s[i]:=UpCase(s[i]);
  43.    d[1]:=UpCase(d[1]);
  44.    if d='D' then delfile:=false;
  45.    If (s='') then begin
  46.     writeln('Usage: LZHC [path] [D]');
  47.     writeln;
  48.     writeln('Examples: LZHC c:\dl\*.*');
  49.     writeln('          LZHC c:\utils\blah.arc');
  50.     writeln;
  51.     writeln('[path] is the path and filename to be converted (can be wildcards)');
  52.     writeln('[D]    means do NOT delete the original file.');
  53.     Halt;
  54.    end;
  55.    FSplit(s,dir,filename,fileext);
  56. end;
  57.  
  58. Procedure Done(error:boolean);
  59. begin
  60.   writeln;
  61.   writeln('Thanks for using LZHConvert!');
  62.   if error then
  63.    writeln('0 files converted, no work to be done!');
  64.   halt;
  65. end;
  66.  
  67. Function ValidExt: boolean;
  68. var b:boolean;
  69. begin
  70.   b:=false;
  71.   FSplit(filepath,dir,filename,fileext);
  72.   s2:=fileext;
  73.   if (s2='.ARC') or (s2='.PAK') or (s2='.ZIP') then b:=true;
  74.   if s2='.ARC' then arcb:=true;
  75.   if s2='.PAK' then pakb:=true;
  76.   if s2='.ZIP' then zipb:=true;
  77.   ValidExt:=b;
  78. end;
  79.  
  80. Procedure Convert;
  81. begin
  82.   x:=0;
  83.   FSplit(filepath,dir,filename,fileext);
  84.   fz:=Srec.Size;
  85.   writeln;
  86.   writeln('File Name: ',dir+filename+fileext);
  87.   writeln('File Size: ',fz,' bytes');
  88.   writeln;
  89.   {$I-} mkdir(workdir) {$I+};
  90.   writeln('Unarcing file to ',workdir);
  91.   if pakb then
  92.   Exec(PAK,' x '+dir+filename+fileext+' '+workdir);
  93.   if zipb then
  94.   Exec(PKUNZIP,' '+dir+filename+fileext+' '+workdir);
  95.   if arcb then
  96.   Exec(PKUNPAK,' '+dir+filename+fileext+' '+workdir);
  97.   i:=DosError;
  98.   if not (i=0) then Done(true);
  99.   writeln;
  100.   writeln('Freezing file(s) to original directory.');
  101.   Exec(LHARC,' a '+dir+filename+' '+workdir+'\*.*');
  102.   writeln;
  103.   writeln('Removing work directory and deleting files in it.');
  104.   writeln;
  105.   DeleteDir(workdir);
  106.   writeln;
  107.   if delfile then begin
  108.    writeln('Deleting original file: ',dir+filename+fileext);
  109.    assign(f,dir+filename+fileext);
  110.    {$I-} erase(f); {$I+};
  111.   end;
  112.   assign(f2,dir+filename+'.LZH');
  113.   reset(f2);
  114.   writeln('Original File Size : ',fz,' bytes');
  115.   fz2:=filesize(f2);
  116.   writeln('New File Size      : ',fz2,' bytes');
  117.   writeln('Bytes Saved        : ',fz-fz2,' bytes');
  118.   close(f2);
  119. end;
  120.  
  121. Procedure ConvertFiles;
  122. begin
  123.   FindFirst(s,0,Srec);
  124.   while DosError=0 do begin
  125.    filepath:=dir+srec.name;
  126.    if ValidExt then Convert;
  127.    FindNext(Srec);
  128.   end;
  129. end;
  130.  
  131. procedure readdata;
  132. var x:integer;
  133. begin
  134.  assign(t,'LZHC.DAT');
  135.  {$I-} reset(t) {$I+};
  136.  if ioresult <> 0 then
  137.  begin
  138.   writeln('Can''t find configuration file "LZHC.DAT"');
  139.   done(true);
  140.  end;
  141.  for x:=1 to 7 do readln(t);
  142.  readln(t,PKUNPAK);
  143.  readln(t,PKUNZIP);
  144.  readln(t,PAK);
  145.  readln(t,LHARC);
  146.  readln(t,WORKDIR);
  147.  close(t);
  148. end;
  149.  
  150. begin
  151.   pakb:=false;
  152.   arcb:=false;
  153.   zipb:=false;
  154.   delfile:=true;
  155.   writeln('LZHConvert v1.0 - Converts ARC/PAK/ZIP files to LHARC format.');
  156.   writeln('(c)1989 CollisionWare(tm) Premium SoftWare, written by Kito Mann.');
  157.   writeln('Collision Theory(tm) pm-BBS 10pm-7am (703)425-4674');
  158.   writeln;
  159.   Parse;
  160.   ReadData;
  161.   ConvertFiles;
  162.   Done(false);
  163. end.
  164.